;;; tex-symb.el --- TeX symbol expansion

;; Copyright (C) 2005, 2007 Free Software Foundation.

;; Author: Masayuki Ataka  <masayuki.ataka@gmail.com>
;; Maintainer: Masayuki Ataka  <masayuki.ataka@gmail.com>
;; Created: 2005-03-02
;; Keywords: tex, wp

;; This file is not part of AUCTeX.

;; tex-symb is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; tex-symb is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with tex-symb; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301, USA.

;;; Commentary:

;; tex-symb provides post-fix type abbrev expansion of greek and symbols like
;; X-Symbol package <http://x-symbol.sourceforge.net/>.
;;
;; Use C-. for greek letter expansion
;;  a C-.   ->  \alpha
;;
;; Use C-, for Symbols expansion
;;  oo C-,  ->  \infty
;;

;;; Code:

(require 'tex)
(require 'texmathp)


(defgroup TeX-symb nil
  "TeX symbol abbrev expansion."
  :group 'AUCTeX)

;;
;; Greeks
;;
(defconst TeX-symb-greek-alist
  '(("a" . "\\alpha")
    ("b" . "\\beta")
    ("c" . "\\chi")
    ("d" . "\\delta")
    ("e" . "\\epsilon")
    ("f" . "\\phi")
    ("g" . "\\gamma")
    ("h" . "\\eta")
    ("i" . "\\iota")
    ("k" . "\\kappa")
    ("l" . "\\lambda")
    ("m" . "\\mu")
    ("n" . "\\nu")
    ("p" . "\\pi")
    ("q" . "\\theta")
    ("r" . "\\rho")
    ("s" . "\\sigma")
    ("t" . "\\tau")
    ("u" . "\\upsilon")
    ("w" . "\\omega")
    ("x" . "\\xi")
    ("y" . "\\psi")
    ("z" . "\\zeta")
    ("D" . "\\Delta")
    ("F" . "\\Phi")
    ("G" . "\\Gamma")
    ("L" . "\\Lambda")
    ("P" . "\\Pi")
    ("Q" . "\\Theta")
    ("S" . "\\Sigma")
    ("U" . "\\Upsilon")
    ("W" . "\\Omega")
    ("X" . "\\Xi")
    ("Y" . "\\Psi")
    ;
    ("ch" . "\\chi")
    ("kh" . "\\chi")
    ("ks" . "\\xi")
    ("ph" . "\\phi")
    ("ps" . "\\psi")
    ("th" . "\\theta")
    ("Ch" . "\\chi")
    ("Kh" . "\\chi")
    ("Ks" . "\\xi")
    ("Ph" . "\\Phi")
    ("Ps" . "\\Psi")
    ("Th" . "\\Theta"))
  "Alist of LaTeX greek letters.")

(defconst TeX-symb-vargreek-alist
  '(("ve" . "\\varepsilon")
    ("vf" . "\\varphi")
    ("vp" . "\\varpi")
    ("vr" . "\\varrho")
    ("vs" . "\\varsigma")
    ("vq" . "\\vartheta")
    ;
    ("vph" . "\\varphi")
    ("vth" . "\\vartheta"))
  "Alist of LaTeX variant greek letters.")

(defconst TeX-symb-vargreek-amssymb-alist
  '(("vk" . "\\varkappa")
    ("vD" . "\\varDelta")
    ("vF" . "\\varPhi")
    ("vG" . "\\varGamma")
    ("vL" . "\\varLambda")
    ("vP" . "\\varPi")
    ("vQ" . "\\varTheta")
    ("vS" . "\\varSigma")
    ("vU" . "\\varUpsilon")
    ("vW" . "\\varOmega")
    ("vX" . "\\varXi")
    ("vY" . "\\varPsi")
    ;
    ("vPh" . "\\varPhi")
    ("vTh" . "\\varTheta")
    ("vPs" . "\\varPsi"))
  "Alist of variant greek letters defined in amssymb package.")


;;
;; Symbols
;;
(defconst TeX-symb-text-alist
  '(;; Text
    ("C"   . "\\copyright")
    ("R"   . "\\textregistered")
    ("TM"  . "\\texttrademark")
    ("*"   . "\\textbullet")
    ("."   . "\\textperiodcentered")
    ("_"   . "\\textvisiblespace")
    ("~"   . "\\textasciitilde")
    ("^"   . "\\textasciicircum")
    ("\\"  . "\\textbackslash")
    ("|"   . "\\textbar")
    ("<"   . "\\textless")
    (">"   . "\\textgreater")
    ("#"   . "\\pounds")
    ("..." . "\\ldots"))
  "Alist of LaTeX symbols used in text mode.")

(defconst TeX-symb-math-alist
  '(("\\" . "\\backslash")
    ("<"  . "\\langle")
    (">"  . "\\rangle")
    ;; Binary Operator
    ("+_"  . "\\pm")
    ("-+"  . "\\mp")
    ("x"   . "\\times")
    ("/"   . "\\div")
    ("*"   . "\\ast")
    ("\\ast"   . "\\star")
    ("o"   . "\\circ")
    ("\\circ" . "\\bullet")
    ("."   . "\\cdot")
    ("u"   . "\\cup")
    ("\\cup" . "\\cap")
    ("u+"  . "\\uplus")
    ("\\cap" . "\\sqcup")
    ("\\sqcup" . "\\sqcap")
    ("v"   . "\\vee")
    ("^"   . "\\wedge")
    ("\\backslash" . "\\setminus")
    ("|>" . "\\triangleright")
    ("<|" . "\\triangleleft")
    ("o+"  . "\\oplus")
    ("o-"  . "\\ominus")
    ("ox"  . "\\otimes")
    ("o/"  . "\\oslash")
    ("o."  . "\\odot")
    ("O" . "\\bigcirc")
    ("t" . "\\dagger")
    ("tt" . "\\ddagger")
    ("\\prod"  . "\\amalg")
    ;; Relation Operator
    ; with direction
    ("<_"  . "\\leq")         (">_"  . "\\geq")
    ("<<"  . "\\ll")          (">>"  . "\\gg")
    ("(" . "\\subset")        (")" . "\\supset")
    ("(_" . "\\subseteq")     (")_" . "\\supseteq")
    ("[_" . "\\sqsubseteq")   ("]_" . "\\sqsupseteq")
    ("|-" . "\\vdash")        ("-|" . "\\dashv")
    ("(-" . "\\in")           ("-)" . "\\ni")
    ("/(-" . "\\notin")
    ; no direction
    ("=_"  . "\\equiv")
    ("~"   . "\\sim")
    ("~_"  . "\\simeq")
    ("~~"  . "\\approx")
    ("~="  . "\\cong")
    ("/="  . "\\neq")
    (".="  . "\\doteq")
    ("oc"  . "\\propto")
    ("|="  . "\\models")
    ("|_" . "\\perp")
    ("|"   . "\\mid")
    ("||"  . "\\parallel")
    ("|x|" . "\\bowtie")
    ("\\subset" . "\\smile")
    ("\\supset" . "\\frown")
    ;; Arrow
    ; horizontal
    ("<-"  . "\\leftarrow")            ("<="  . "\\Leftarrow")
    ("<--" . "\\longleftarrow")        ("<==" . "\\Longleftarrow")
    ("->"  . "\\rightarrow")           ("=>"  . "\\Rightarrow")
    ("-->" . "\\longrightarrow")       ("==>" . "\\Longrightarrow")
    ("<->"  . "\\leftrightarrow")      ("<=>"  . "\\Leftrightarrow")
    ("<-->" . "\\longleftrightarrow")  ("<==>" . "\\Longleftrightarrow")
    ("\\Longleftrightarrow" . "\\iff")
    ; vertical
    ("^|" . "\\uparrow")               ("^||" . "\\Uparrow")
    ("|v" . "\\downarrow")             ("||v" . "\\Downarrow")
    ("^|v" . "\\updownarrow")          ("^||v" . "\\Updownarrow")
    ; misc
    ("|->" . "\\mapsto")
    ("|-->" . "\\longmapsto")
    ;; Misc symbol
    ("N" . "\\aleph")
    ("h" . "\\hbar")
    ("i" . "\\imath")
    ("j" . "\\jmath")
    ("l" . "\\ll")
    ("p" . "\\wp")
    ("R" . "\\Re")
    ("I" . "\\Im")
    ("d" . "\\partial")
    ("\\delta" . "\\partial")
    ("oo" . "\\infty")
    ("'" . "\\prime")
    ("0"  . "\\emptyset")
    ("\\Delta" . "\\nabla")
    ("T" . "\\top")
    ("perp" . "\\bot")
    ("/_" . "\\angle")
    ("A"  . "\\forall")
    ("E"  . "\\exists")
    ("b"  . "\\flat")
    ("#"  . "\\sharp")
    ;; Big Opetator
    ("\\Sigma" . "\\sum")
    ("\\Pi"    . "\\prod")
    ("\\amalg" . "\\coprod")
    ("U"   . "\\bigcup")
    ("U+"  . "\\biguplus")
    ("\\bigcup" . "\\bigcap")
    ("V"   . "\\bigvee")
    ("\\wedge" . "\\bigwedge")
    ("O."  . "\\bigodot")
    ("Ox"  . "\\bigotimes")
    ("O+"  . "\\bigoplus"))
  "Alist of LaTeX symbols used in math mode.")

(defconst TeX-symb-math-amssymb-alist
  '(("..." . "\\dots")
    ;; Binary Operator
    ("[.]" . "\\boxdot")
    ("[+]" . "\\boxplus")
    ("[x]" . "\\boxtimes")
    ("[-]" . "\\boxminus")
    ("\\dot" . "\\centerdot")
    ("v_" . "\\veebar")
    ("_^" . "\\barwedge")
    ("=^" . "\\doublebarwedge")
    ("Uu" . "\\Cup")
    ("\\Cup" . "\\Cap")
    ("\\wedge" . "\\curlywedge")
    ("\\vee" . "\\curlyvee")
    ("\\times" . "\\leftthreetimes")
    ("\\leftthreetimes" . "\\rightthreetimes")
    (".+" . "\\dotplus")
    ("\\top"  . "\\intercal")
    ("Oo" . "\\circledcirc")
    ("O*" . "\\circledast")
    ("O-" . "\\circleddash")
    ("/x" . "\\divideontimes")
    ("<." . "\\lessdot")
    (">." . "\\gtrdot")
    ("|x" . "\\ltimes")
    ("x|" . "\\rtimes")
    ;; Relation 1
    ("->>" . "\\twoheadrightarrow")
    ("<<-" . "\\twoheadleftarrow")
    ("\\leftarrow" . "\\leftleftarrows")
    ("\\rightarrow" . "\\rightrightarrows")
    ("\\leftrightarrow" . "\\leftrightarrows")
    ("\\leftrightarrows" . "\\rightleftarrows")
    ("o=" . "\\circeq")
    (">~" . "\\gtrsim")
    (">~~" . "\\gtrapprox")
    ("-o" . "\\multimap")
    ("\\dots" . "\\therefore")
    ("\\therefore" . "\\because")
    (".=." . "\\doteqdot")
    ("<~" . "\\lesssim")
    ("<~~" . "\\lessapprox")
    ("/<" . "\\eqslantless")
    ("\\<" . "\\eqslantgtr")
    ;; Relation 2
    ("<__" . "\\leqq")
    ("<\\" . "\\leqslant")
    ("<>" . "\\lessgtr")
    ("\\doteqdot" . "\\risingdotseq")
    ("\\risingdotseq" . "\\fallingdotseq")
    (">__" . "\\geqq")
    (">/" . "\\geqslant")
    ("><" . "\\gtrless")
    ("[" . "\\sqsubset")
    ("]" . "\\sqsupset")
    ("\\triangleright" . "\\vartriangleright")
    ("\\triangleleft" . "\\vartriangleleft")
    ("|>_" . "\\trianglerighteq")
    ("<|_" . "\\trianglelefteq")
    (")(" . "\\between")
    ("\\vartriangleright" . "\\blacktriangleright")
    ("\\vartriangleleft" . "\\blacktriangleleft")
    ("=o" . "\\eqcirc")
    ("<_>" . "\\lesseqgtr")
    (">_<" . "\\gtreqless")
    ("<__>" . "\\lesseqqgtr")
    (">__<" . "\\gtreqqless")
    ("\\Rightarrow" . "\\Rrightarrow")
    ("\\Leftarrow" . "\\Lleftarrow")
    ("\\propto" . "\\varpropto")
    ("\\smile" . "\\smallsmile")
    ("\\frown" . "\\smallfrown")
    ("((" . "\\Subset")
    ("))" . "\\Supset")
    ("(__" . "\\subseteqq")
    (")__" . "\\supseteqq")
    ("<<<" . "\\lll")
    (">>>" . "\\ggg")
    ("\\sim" . "\\backsim")
    ("\\simeq" . "\\backsimeq")
    ;; Relation 3
    ("\\mid" . "\\shortmid")
    ("\\parallel" . "\\shortparallel")
    ("\\backsim" . "\\thicksim")
    ("\\approx" . "\\thickapprox")
    ("~~_" . "\\approxeq")
    ("\\epsilon" . "\\backepsilon")
    ;; Misc
    ("[]" . "\\square")
    ("\\square" . "\\blacksquare")
    ("`" . "\\backprime")
    ("\\star" . "\\bigstar")
    ("\\angle" . "\\measuredangle")
    ("\\measuredangle" . "\\sphericalangle")
    ("Os" . "\\circledS")
    ("C" . "\\complement")
    ("/" . "\\diagup")
    ("\\setminus" . "\\diagdown")
    ("\\emptyset" . "\\vernothing")
    ("/E" . "\\nexsists")
    ("F" . "\\Finv")
    ("G" . "\\Game")
    ("\\Omega" . "\\mho")
    ("\\partial" . "\\eth")
    ("kk" . "\\Bbbk")
    ("h/" . "\\hslash"))
  "Alist of math symbols defined in amssymb package.")


;;
;; TeX-symb-make-expand-defun
;;

(defun TeX-symb-make-expand-defun (name)
  "Return a function definition for expanding abbrevs.

The generated function `TeX-symb-NAME-expand' expand an abbrev
using the rule `TeX-symb-NAME-alist'.  `TeX-symb-NAME-alist'
should be an alist or a function that returns an alist.  Alist
should be (ABBREV . EXPANDED-TEXT)."
  (let ((alist (intern (concat "TeX-symb-" name "-alist"))))
    (eval `(defun ,(intern (concat "TeX-symb-" name "-expand")) ()
	     "Generated by `TeX-symb-make-expand-defun'."
	     (interactive)
	     (let ((pos (point)) result token
		   (list (TeX-symb-reverse-string-list
			  (cond
			   ((listp ,alist) ,alist)
			   ((functionp ,alist) (funcall ,alist))
			   (t (error "%s should be alist or function" ,alist))))))
	       (while (setq result (TeX-symb-ref-string (char-before pos) list))
		 (setq list result
		       pos (1- pos)))
	       (setq token (TeX-symb-first-string list))
	       (when token
		 (delete-backward-char (- (point) pos))
		 (insert token)
		 (TeX-symb-auto-fold)))))))

(defsubst TeX-symb-first-string (alist)
  "Return a list of cars of ALIST."
  (car (delete nil (mapcar (lambda (x) (and (stringp (car x)) (car x))) alist))))

(defsubst TeX-symb-ref-string (ch alist)
  "Return a list of cdrs of ALIST which car is equal to CH."
  (delete nil (mapcar (lambda (elt) (and (equal ch (car elt)) (cdr elt))) alist)))

(defsubst TeX-symb-reverse-string-list (alist)
  "Return a list of (CAR-CONVERTED-TO-CHARS-IN-REVERSE-ORDER CDR)."
  (mapcar (lambda (x) `(,@(nreverse (string-to-list (car x))) ,(cdr x))) alist))


;;
;; TeX-symb-greek-expand
;;
(TeX-symb-make-expand-defun "greek-letter")

(defcustom TeX-symb-greek-letter-alist #'TeX-symb-greek-letter-alist
  "*Alist or a function that returns alist, which value should be (ABBREV . TEX-COMMAND).
This alist is used by a function `TeX-symb-greek-letter-expand'."
  :group 'TeX-symb
  :type '(choice (function) (alist)))

(defun TeX-symb-greek-letter-alist ()
  "Return an alist of TeX greek letters."
  (if (fboundp 'TeX-symb-greek-letter-user-alist)
      (TeX-symb-greek-letter-user-alist)
    (cond
     (t (append
	 (and (assoc "amssymb" TeX-style-hook-list) TeX-symb-vargreek-amssymb-alist)
	  TeX-symb-greek-alist TeX-symb-vargreek-alist)))))

;;
;; TeX-symb-symbol-expand
;;
(TeX-symb-make-expand-defun "symbol")

(defcustom TeX-symb-symbol-alist #'TeX-symb-symbol-alist
  "*Alist or a function that returns alist, which value should be (ABBREV . TEX-COMMAND).
This alist is used by a function `TeX-symb-symbol-expand'."
  :group 'TeX-symb
  :type '(choice (function) (alist)))

(defun TeX-symb-symbol-alist ()
  "Return an alist of TeX symbols."
  (if (fboundp 'TeX-symb-symbol-user-alist)
      (TeX-symb-symbol-user-alist)
    (cond
     (t (if (texmathp)
	    (append
	     (and (assoc "amssymb" TeX-style-hook-list) TeX-symb-math-amssymb-alist)
	      TeX-symb-math-alist)
	  TeX-symb-text-alist)))))

;;
;; misc
;;
(defcustom TeX-symb-auto-fold t
  "*If non-nil, fold macros just after command `TeX-symb-*-expand'."
  :group 'TeX-fold
  :type 'boolean)

(defun TeX-symb-auto-fold ()
  (when (and TeX-symb-auto-fold (featurep 'tex-fold)
	     TeX-fold-mode)
    (let* ((it-start (save-excursion (backward-char) (TeX-find-macro-start)))
	   (it (when it-start
		  (save-excursion
		    (goto-char it-start)
		    (looking-at (concat (regexp-quote TeX-esc)
					"\\([A-za-z@*]+\\)"))
		  (if (fboundp 'match-string-no-properties)
		      (match-string-no-properties 1)
		    (match-string 1))))))
      (when (delete nil
		    (mapcar (lambda (fold-list) (member it (cadr fold-list)))
			    TeX-fold-math-spec-list))
	(save-excursion
	  (backward-char 1)
	  (TeX-fold-math))))))

;;; The mode

(defvar TeX-symb-keymap 
  (let ((map (make-sparse-keymap)))
    (define-key map [(control ?\.)] 'TeX-symb-greek-letter-expand)
    (define-key map [(control ?\,)] 'TeX-symb-symbol-expand)
    map))

(define-key TeX-mode-map "\C-c\C-o\C-s" 'TeX-symb-mode)

(define-minor-mode TeX-symb-mode
  "Minor mode for providing abbrev expansion of symbols and greek letters.

Called interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
With zero or negative ARG turn mode off."
  nil ":xs" TeX-symb-keymap)


(provide 'tex-symb)

;;; tex-symb.el ends here
